unit aboutunit; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, ButtonPanel, Buttons, StdCtrls; 

const 
  AboutSText = 
    '"ABC Questionnaire is a rendering engine and",' +
    '"evaluator of specially structured .CSV files,",' +
    '"designed to be portable and not complex.",' +
    '"",' +
    '"Licensed with the OpenBSD licensed, you are allowed to",' +
    '"make a profit with this software.",' +
    '"",' +
    '"Source:",' +
    '"http://code.google.com/p/abcquestionnaire/",' +
    '"",' +
    '""';
     
  LicenseSText =
    '" Copyright (c) 2009 Reenen Laurie <rlaurie@gmail.com>",' +
    '"",' + 
    '"Permission to use, copy, modify, and distribute this",' +
    '"software for any purpose with or without fee is hereby",' +
    '"granted, provided that the above copyright notice and",' +
    '"this permission notice appear in all copies.",' +
    '"",' +
    '"The software is provided ""as is"" and the author",' +
    '"disclaims all warranties with regard to this",' +
    '"software including all implied warranties of",' +
    '"merchantability and fitness.",' + 
    '"#In no event shall the author be liable for any",' +
    '"#special, direct, indirect, or consequential damages",' +
    '"or any damages whatsoever resulting from loss of use,",' + 
    '"data or profits, whether in an action of contract,",' +  
    '"negligence or other tortious action, arising out",' +
    '"tortious action, arising out of or in connection",' +
    '"with the use or performance of this software.",';

 

      
  
type
  TScrollingText = class(TGraphicControl)
  private
    FActive: boolean;
    FActiveLine: integer;   //the line over which the mouse hovers
    FBuffer: TBitmap;
    FEndLine: integer;
    FLineHeight: integer;
    FLines: TStrings;
    FNumLines: integer;
    FOffset: integer;
    FStartLine: integer;
    FStepSize: integer;
    FTimer: TTimer;
    function ActiveLineIsURL: boolean;
    procedure DoTimer(Sender: TObject);
    procedure SetActive(const AValue: boolean);
    procedure Initialise;
    procedure DrawScrollingText(Sender: TObject);
  protected
    procedure DoOnChangeBounds; override;
    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Active: boolean read FActive write SetActive;
    property Lines: TStrings read FLines write FLines;
  end;  

  { TAboutForm }

  TAboutForm = class ( TForm ) 
   CloseButton : TBitBtn;
   Notebook1 : TNotebook;
   AboutPage : TPage;
   LicensePage : TPage;
   Panel1 : TPanel;
   procedure CloseButtonClick ( Sender : TObject ) ;
   procedure FormCreate ( Sender : TObject ) ;
   procedure Notebook1PageChanged ( Sender : TObject ) ;
  private
    { private declarations }
    LicenseText : TScrollingText;
    //AboutText : TScrollingText;
    AboutText : TMemo;
  public
    { public declarations }
  end; 

var
  AboutForm : TAboutForm; 

implementation

{ TAboutForm }

procedure TAboutForm.CloseButtonClick ( Sender : TObject ) ;
begin
  close;
end;

procedure TAboutForm.FormCreate ( Sender : TObject ) ;
begin
  //AboutText := TScrollingText.Create(AboutPage);
  AboutText := TMemo.Create(AboutPage);
  AboutText.ReadOnly := true;
  AboutText.Parent := AboutPage;
  AboutText.Align := alClient;
  AboutText.Lines.CommaText := AboutSText;
  
  LicenseText := TScrollingText.Create(LicensePage);
  LicenseText.Parent := LicensePage;
  LicenseText.Align := alClient;
  LicenseText.Lines.CommaText := LicenseSText; 
  
  Notebook1.PageIndex := 0;
  Notebook1PageChanged(self);
end;

procedure TAboutForm.Notebook1PageChanged ( Sender : TObject ) ;
begin
  if Assigned(AboutText) then
    //AboutText.Active := NoteBook1.ActivePage = 'About';
  if Assigned(LicenseText) then
    LicenseText.Active := NoteBook1.ActivePage = 'License';  
end;


  
  
{ TScrollingText }

procedure TScrollingText.SetActive(const AValue: boolean);
begin
  FActive := AValue;
  Initialise;
  FTimer.Enabled:=Active;
end;

procedure TScrollingText.Initialise;
begin
  FBuffer.Width := Width;
  FBuffer.Height := Height;
  FLineHeight := FBuffer.Canvas.TextHeight('X');
  FNumLines := FBuffer.Height div FLineHeight;

  if FOffset = -1 then
    FOffset := FBuffer.Height;
end;

procedure TScrollingText.DrawScrollingText(Sender: TObject);
begin
  if Active then
    Canvas.Draw(0,0,FBuffer);
end;

procedure TScrollingText.DoTimer(Sender: TObject);
var
  w: integer;
  s: string;
  i: integer;
begin
  if not Active then
    Exit;

  Dec(FOffset, FStepSize);

  if FOffSet < 0 then
    FStartLine := -FOffset div FLineHeight
  else
    FStartLine := 0;

  FEndLine := FStartLine + FNumLines + 1;
  if FEndLine > FLines.Count - 1 then
    FEndLine := FLines.Count - 1;

  FBuffer.Canvas.FillRect(Rect(0, 0, FBuffer.Width, FBuffer.Height));

  for i := FEndLine downto FStartLine do
  begin
    s := Trim(FLines[i]);

    //reset buffer font
    FBuffer.Canvas.Font.Style := [];
    FBuffer.Canvas.Font.Color := clBlack;

    //skip empty lines
    if Length(s) > 0 then
    begin
      //check for bold format token
      if s[1] = '#' then
      begin
        s := copy(s, 2, Length(s) - 1);
        FBuffer.Canvas.Font.Style := [fsBold];
      end
      else
      begin
        //check for url
        {if Pos('http://', s) = 1 then
        begin
          if i = FActiveLine then
          begin
            FBuffer.Canvas.Font.Style := [fsUnderline];
            FBuffer.Canvas.Font.Color := clRed;
          end
          else
            FBuffer.Canvas.Font.Color := clBlue;
         end;}
      end;

      w := FBuffer.Canvas.TextWidth(s);
      FBuffer.Canvas.TextOut((FBuffer.Width - w) div 2, FOffset + i * FLineHeight, s);
    end;
  end;

  //start showing the list from the start
  if FStartLine > FLines.Count - 1 then
    FOffset := FBuffer.Height;
  Invalidate;
end;

function TScrollingText.ActiveLineIsURL: boolean;
begin
  if (FActiveLine > 0) and (FActiveLine < FLines.Count -1) then
    Result := Pos('http://', FLines[FActiveLine]) = 1
  else
    Result := False;
end;

procedure TScrollingText.DoOnChangeBounds;
begin
  inherited DoOnChangeBounds;
  Initialise;
end;

procedure TScrollingText.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);

begin
end;

procedure TScrollingText.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
end;

constructor TScrollingText.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  ControlStyle := ControlStyle + [csOpaque];

  OnPaint := @DrawScrollingText;
  FLines := TStringList.Create;
  FTimer := TTimer.Create(nil);
  FTimer.OnTimer:=@DoTimer;
  FTimer.Interval:=50;
  FBuffer := TBitmap.Create;

  FStepSize := 1;
  FStartLine := 0;
  FOffset := 270;
end;

destructor TScrollingText.Destroy;
begin
  FLines.Free;
  FTimer.Free;
  FBuffer.Free;
  inherited Destroy;
end;   



initialization
  {$I aboutunit.lrs} 
end.

